indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.3 v dplyr 1.0.7
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 2.0.0 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 450)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 12.92867 12.92824 12.92779 12.92734 12.92687 12.92640 12.92592 12.92543
## [9] 12.92494 12.92444 12.92395 12.92345 12.92296 12.92247 12.92199 12.92152
## [17] 12.92105 12.92060 12.92015 12.91972 12.91931 12.91891 12.91854 12.91818
## [25] 12.91784 12.91753 12.91725 12.91699 12.91676 12.91656 12.91639 12.91625
## [33] 12.91615 12.91609 12.91607 12.91608 12.91614 12.91624 12.91639 12.91658
## [41] 12.91682 12.91711 12.91745 12.91785 12.91830 12.91881 12.91937 12.91998
## [49] 12.92064 12.92134 12.92208 12.92287 12.92370 12.92456 12.92546 12.92640
## [57] 12.92736 12.92836 12.92938 12.93043 12.93150 12.93259 12.93370 12.93482
## [65] 12.93597 12.93712 12.93829 12.93946 12.94065 12.94183 12.94302 12.94421
## [73] 12.94540 12.94659 12.94777 12.94894 12.95010 12.95126 12.95239 12.95352
## [81] 12.95462 12.95570 12.95677 12.95781 12.95882 12.95981 12.96076 12.96168
## [89] 12.96257 12.96343 12.96424 12.96502 12.96584 12.96680 12.96789 12.96910
## [97] 12.97042 12.97186 12.97339 12.97501 12.97673 12.97852 12.98038 12.98230
## [105] 12.98429 12.98632 12.98839 12.99051 12.99265 12.99481 12.99699 12.99917
## [113] 13.00135 13.00353 13.00569 13.00783 13.00994 13.01202 13.01405 13.01604
## [121] 13.01796 13.01983 13.02162 13.02333 13.02496 13.02649 13.02792 13.02925
## [129] 13.03046 13.03155 13.03251 13.03334 13.03402 13.03455 13.03493 13.03568
## [137] 13.03727 13.03961 13.04261 13.04618 13.05022 13.05465 13.05937 13.06430
## [145] 13.06933 13.07439 13.07936 13.08418 13.08874 13.09295 13.09672 13.09996
## [153] 13.10258 13.10448 13.10557 13.10577 13.10582 13.10649 13.10774 13.10953
## [161] 13.11180 13.11451 13.11762 13.12107 13.12482 13.12883 13.13304 13.13742
## [169] 13.14191 13.14647 13.15105 13.15560 13.16009 13.16445 13.16866 13.17265
## [177] 13.17638 13.17982 13.18290 13.18558 13.18783 13.18958 13.19080 13.19143
## [185] 13.19144 13.19077 13.18938 13.18722 13.18425 13.18045 13.17587 13.17055
## [193] 13.16454 13.15789 13.15063 13.14281 13.13447 13.12567 13.11643 13.10682
## [201] 13.09686 13.08662 13.07612 13.06541 13.05455 13.04356 13.03251 13.02142
## [209] 13.01035 12.99934 12.98843 12.97767 12.96710 12.95677 12.94672 12.93699
## [217] 12.92763 12.91774 12.90648 12.89396 12.88029 12.86560 12.84998 12.83357
## [225] 12.81647 12.79880 12.78068 12.76221 12.74352 12.72472 12.70593 12.68725
## [233] 12.66881 12.65072 12.63309 12.61604 12.59969 12.58414 12.56952 12.55594
## [241] 12.54223 12.52723 12.51108 12.49389 12.47581 12.45697 12.43749 12.41750
## [249] 12.39713 12.37653 12.35580 12.33509 12.31453 12.29424 12.27435 12.25501
## [257] 12.23632 12.21844 12.20148 12.18558 12.17086 12.15662 12.14205 12.12721
## [265] 12.11212 12.09682 12.08136 12.06576 12.05007 12.03432 12.01854 12.00278
## [273] 11.98707 11.97145 11.95596 11.94062 11.92549 11.91059 11.89596 11.88165
## [281] 11.86767 11.85409 11.84092 11.82821 11.81599 11.80430 11.79318 11.78240
## [289] 11.77172 11.76115 11.75071 11.74040 11.73026 11.72028 11.71048 11.70087
## [297] 11.69148 11.68230 11.67337 11.66468 11.65626 11.64811 11.64026 11.63271
## [305] 11.62548 11.61858 11.61203 11.60584 11.60002 11.59459 11.58905 11.58292
## [313] 11.57628 11.56920 11.56176 11.55401 11.54604 11.53791 11.52970 11.52147
## [321] 11.51330 11.50526 11.49742 11.48984 11.48261 11.47579 11.46945 11.46366
## [329] 11.45850 11.45404 11.45034 11.44748 11.44552 11.44455 11.44463 11.44582
## [337] 11.44821 11.45184 11.45662 11.46248 11.46930 11.47699 11.48545 11.49459
## [345] 11.50431 11.51451 11.52509 11.53596 11.54702 11.55816 11.56930 11.58034
## [353] 11.59117 11.60170 11.61184 11.62148 11.63053 11.63951 11.64899 11.65895
## [361] 11.66938 11.68023 11.69151 11.70318 11.71522 11.72762 11.74035 11.75340
## [369] 11.76673 11.78033 11.79417 11.80825 11.82252 11.83698 11.85161 11.86637
## [377] 11.88126 11.89625 11.91131 11.92643 11.94158 11.95675 11.97191 11.98705
## [385] 12.00213 12.01733 12.03279 12.04853 12.06453 12.08079 12.09730 12.11405
## [393] 12.13104 12.14826 12.16571 12.18338 12.20126 12.21936 12.23765 12.25614
## [401] 12.27481 12.29367 12.31271 12.33192 12.35129 12.37082 12.39054 12.41050
## [409] 12.43067 12.45108 12.47170 12.49255 12.51361 12.53489 12.55638 12.57808
## [417] 12.59999 12.62211 12.64442 12.66694 12.68966 12.71257 12.73568 12.75898
## [425] 12.78246 12.80614 12.83000 12.85404 12.87826 12.90260 12.92701 12.95151
## [433] 12.97610 13.00079 13.02559 13.05051 13.07557 13.10077 13.12613 13.15165
## [441] 13.17734 13.20321 13.22928 13.25556 13.28204 13.30876 13.33570 13.36289
## [449] 13.39034 13.41805#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log10 SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 450)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.42164 12.42463 12.42759 12.43052 12.43343 12.43632 12.43919 12.44204
## [9] 12.44488 12.44770 12.45051 12.45331 12.45611 12.45890 12.46169 12.46448
## [17] 12.46727 12.47007 12.47287 12.47568 12.47851 12.48135 12.48420 12.48707
## [25] 12.48996 12.49288 12.49581 12.49878 12.50178 12.50480 12.50786 12.51096
## [33] 12.51409 12.51726 12.52048 12.52374 12.52705 12.53040 12.53381 12.53727
## [41] 12.54079 12.54436 12.54800 12.55169 12.55543 12.55923 12.56307 12.56696
## [49] 12.57089 12.57486 12.57886 12.58291 12.58698 12.59109 12.59523 12.59940
## [57] 12.60359 12.60780 12.61203 12.61628 12.62055 12.62482 12.62911 12.63341
## [65] 12.63772 12.64203 12.64634 12.65065 12.65496 12.65926 12.66356 12.66785
## [73] 12.67212 12.67638 12.68063 12.68486 12.68906 12.69325 12.69740 12.70154
## [81] 12.70564 12.70971 12.71374 12.71774 12.72170 12.72562 12.72949 12.73332
## [89] 12.73710 12.74083 12.74451 12.74814 12.75184 12.75577 12.75989 12.76421
## [97] 12.76871 12.77337 12.77819 12.78315 12.78824 12.79345 12.79876 12.80417
## [105] 12.80965 12.81521 12.82082 12.82648 12.83216 12.83787 12.84359 12.84930
## [113] 12.85499 12.86065 12.86627 12.87184 12.87734 12.88276 12.88809 12.89332
## [121] 12.89843 12.90342 12.90826 12.91296 12.91749 12.92184 12.92600 12.92997
## [129] 12.93372 12.93724 12.94053 12.94356 12.94634 12.94938 12.95317 12.95763
## [137] 12.96267 12.96820 12.97414 12.98041 12.98690 12.99355 13.00026 13.00695
## [145] 13.01353 13.01991 13.02602 13.03175 13.03704 13.04179 13.04591 13.04932
## [153] 13.05194 13.05367 13.05517 13.05711 13.05946 13.06216 13.06517 13.06846
## [161] 13.07198 13.07568 13.07953 13.08348 13.08749 13.09152 13.09552 13.09945
## [169] 13.10328 13.10695 13.11042 13.11365 13.11660 13.11923 13.12149 13.12335
## [177] 13.12475 13.12566 13.12603 13.12582 13.12499 13.12349 13.12128 13.11837
## [185] 13.11479 13.11058 13.10577 13.10041 13.09452 13.08815 13.08133 13.07411
## [193] 13.06651 13.05857 13.05033 13.04183 13.03311 13.02419 13.01512 13.00594
## [201] 12.99667 12.98737 12.97806 12.96878 12.95957 12.95047 12.94150 12.93272
## [209] 12.92415 12.91584 12.90781 12.90011 12.89179 12.88198 12.87077 12.85828
## [217] 12.84463 12.82993 12.81430 12.79785 12.78069 12.76293 12.74470 12.72610
## [225] 12.70725 12.68826 12.66925 12.65033 12.63161 12.61321 12.59525 12.57783
## [233] 12.56107 12.54508 12.52998 12.51588 12.50290 12.49114 12.47975 12.46781
## [241] 12.45539 12.44253 12.42930 12.41574 12.40193 12.38790 12.37373 12.35946
## [249] 12.34515 12.33086 12.31664 12.30255 12.28865 12.27499 12.26163 12.24862
## [257] 12.23603 12.22390 12.21229 12.20107 12.19005 12.17921 12.16856 12.15808
## [265] 12.14776 12.13759 12.12755 12.11765 12.10786 12.09818 12.08860 12.07910
## [273] 12.06968 12.06033 12.05103 12.04178 12.03256 12.02337 12.01419 12.00502
## [281] 11.99584 11.98664 11.97758 11.96882 11.96034 11.95213 11.94418 11.93648
## [289] 11.92902 11.92179 11.91477 11.90795 11.90133 11.89489 11.88863 11.88252
## [297] 11.87656 11.87074 11.86504 11.85946 11.85398 11.84859 11.84329 11.83805
## [305] 11.83288 11.82775 11.82266 11.81759 11.81194 11.80519 11.79746 11.78889
## [313] 11.77959 11.76969 11.75932 11.74861 11.73766 11.72662 11.71561 11.70475
## [321] 11.69417 11.68399 11.67434 11.66534 11.65712 11.64980 11.64351 11.63838
## [329] 11.63453 11.63208 11.63116 11.63111 11.63120 11.63144 11.63186 11.63246
## [337] 11.63325 11.63426 11.63549 11.63695 11.63868 11.64067 11.64294 11.64550
## [345] 11.64838 11.65158 11.65512 11.65901 11.66326 11.66790 11.67293 11.67837
## [353] 11.68425 11.69057 11.69732 11.70450 11.71207 11.72003 11.72836 11.73704
## [361] 11.74606 11.75540 11.76505 11.77499 11.78521 11.79569 11.80641 11.81736
## [369] 11.82853 11.83990 11.85144 11.86316 11.87503 11.88703 11.89915 11.91138
## [377] 11.92370 11.93609 11.94854 11.96103 11.97366 11.98654 11.99966 12.01304
## [385] 12.02666 12.04053 12.05464 12.06900 12.08361 12.09846 12.11356 12.12891
## [393] 12.14450 12.16034 12.17642 12.19275 12.20932 12.22614 12.24320 12.26051
## [401] 12.27806 12.29586 12.31390 12.33219 12.35072 12.36949 12.38852 12.40781
## [409] 12.42735 12.44716 12.46722 12.48753 12.50810 12.52891 12.54997 12.57127
## [417] 12.59281 12.61459 12.63662 12.65887 12.68136 12.70408 12.72703 12.75020
## [425] 12.77360 12.79722 12.82106 12.84512 12.86940 12.89385 12.91846 12.94322
## [433] 12.96815 12.99325 13.01853 13.04399 13.06964 13.09549 13.12154 13.14781
## [441] 13.17428 13.20098 13.22790 13.25507 13.28247 13.31012 13.33802 13.36618
## [449] 13.39461 13.42331#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log10 SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 450)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 11.85909 11.85879 11.85850 11.85822 11.85795 11.85770 11.85745 11.85723
## [9] 11.85702 11.85683 11.85666 11.85652 11.85640 11.85631 11.85624 11.85621
## [17] 11.85620 11.85623 11.85630 11.85640 11.85654 11.85672 11.85695 11.85722
## [25] 11.85753 11.85789 11.85830 11.85875 11.85927 11.85983 11.86045 11.86113
## [33] 11.86187 11.86267 11.86353 11.86445 11.86545 11.86650 11.86763 11.86883
## [41] 11.87011 11.87145 11.87288 11.87438 11.87596 11.87762 11.87937 11.88120
## [49] 11.88312 11.88513 11.88724 11.88946 11.89180 11.89425 11.89681 11.89946
## [57] 11.90222 11.90506 11.90800 11.91102 11.91413 11.91731 11.92057 11.92390
## [65] 11.92729 11.93075 11.93426 11.93784 11.94146 11.94513 11.94884 11.95259
## [73] 11.95638 11.96020 11.96405 11.96792 11.97182 11.97572 11.97965 11.98358
## [81] 11.98751 11.99145 11.99538 11.99931 12.00323 12.00713 12.01101 12.01488
## [89] 12.01871 12.02252 12.02629 12.03003 12.03372 12.03737 12.04097 12.04451
## [97] 12.04800 12.05143 12.05480 12.05822 12.06181 12.06556 12.06946 12.07351
## [105] 12.07769 12.08200 12.08642 12.09094 12.09556 12.10026 12.10504 12.10989
## [113] 12.11480 12.11975 12.12475 12.12977 12.13481 12.13986 12.14491 12.14996
## [121] 12.15498 12.15998 12.16494 12.16986 12.17472 12.17951 12.18423 12.18886
## [129] 12.19340 12.19784 12.20216 12.20636 12.21043 12.21436 12.21814 12.22254
## [137] 12.22826 12.23517 12.24312 12.25198 12.26161 12.27188 12.28265 12.29378
## [145] 12.30514 12.31659 12.32799 12.33920 12.35010 12.36054 12.37038 12.37950
## [153] 12.38775 12.39500 12.40110 12.40593 12.41064 12.41642 12.42321 12.43091
## [161] 12.43946 12.44878 12.45880 12.46944 12.48061 12.49226 12.50429 12.51664
## [169] 12.52923 12.54198 12.55481 12.56766 12.58044 12.59308 12.60550 12.61762
## [177] 12.62938 12.64069 12.65148 12.66167 12.67118 12.67995 12.68788 12.69492
## [185] 12.70098 12.70598 12.70985 12.71252 12.71391 12.71396 12.71274 12.71031
## [193] 12.70676 12.70216 12.69658 12.69010 12.68279 12.67474 12.66601 12.65668
## [201] 12.64682 12.63652 12.62584 12.61486 12.60366 12.59231 12.58088 12.56946
## [209] 12.55812 12.54693 12.53596 12.52530 12.51502 12.50519 12.49589 12.48719
## [217] 12.47917 12.47056 12.46013 12.44804 12.43444 12.41948 12.40331 12.38608
## [225] 12.36795 12.34907 12.32958 12.30965 12.28942 12.26904 12.24866 12.22845
## [233] 12.20854 12.18909 12.17025 12.15218 12.13502 12.11893 12.10406 12.09056
## [241] 12.07715 12.06255 12.04687 12.03023 12.01277 11.99460 11.97584 11.95661
## [249] 11.93705 11.91726 11.89738 11.87752 11.85781 11.83837 11.81933 11.80080
## [257] 11.78290 11.76576 11.74951 11.73426 11.72013 11.70636 11.69212 11.67747
## [265] 11.66246 11.64714 11.63156 11.61578 11.59984 11.58379 11.56770 11.55161
## [273] 11.53557 11.51964 11.50386 11.48829 11.47299 11.45799 11.44336 11.42915
## [281] 11.41540 11.40218 11.38952 11.37749 11.36614 11.35551 11.34567 11.33636
## [289] 11.32731 11.31853 11.31001 11.30175 11.29375 11.28602 11.27855 11.27134
## [297] 11.26439 11.25770 11.25127 11.24511 11.23920 11.23355 11.22817 11.22304
## [305] 11.21818 11.21357 11.20922 11.20513 11.20130 11.19773 11.19411 11.19018
## [313] 11.18598 11.18156 11.17697 11.17224 11.16744 11.16260 11.15777 11.15299
## [321] 11.14833 11.14381 11.13949 11.13542 11.13163 11.12819 11.12513 11.12250
## [329] 11.12034 11.11871 11.11765 11.11721 11.11743 11.11836 11.12005 11.12254
## [337] 11.12588 11.13016 11.13540 11.14151 11.14841 11.15603 11.16429 11.17311
## [345] 11.18241 11.19212 11.20215 11.21242 11.22287 11.23341 11.24395 11.25444
## [353] 11.26477 11.27489 11.28470 11.29413 11.30310 11.31206 11.32146 11.33131
## [361] 11.34156 11.35222 11.36325 11.37464 11.38637 11.39842 11.41076 11.42339
## [369] 11.43629 11.44942 11.46278 11.47634 11.49008 11.50399 11.51805 11.53224
## [377] 11.54653 11.56091 11.57536 11.58986 11.60439 11.61894 11.63347 11.64798
## [385] 11.66244 11.67702 11.69187 11.70698 11.72236 11.73798 11.75384 11.76994
## [393] 11.78626 11.80279 11.81953 11.83646 11.85358 11.87088 11.88834 11.90597
## [401] 11.92375 11.94168 11.95973 11.97792 11.99622 12.01462 12.03318 12.05195
## [409] 12.07092 12.09008 12.10945 12.12901 12.14875 12.16869 12.18881 12.20912
## [417] 12.22961 12.25027 12.27111 12.29213 12.31331 12.33466 12.35617 12.37785
## [425] 12.39968 12.42167 12.44381 12.46611 12.48855 12.51108 12.53365 12.55627
## [433] 12.57894 12.60169 12.62451 12.64743 12.67044 12.69358 12.71683 12.74022
## [441] 12.76376 12.78745 12.81131 12.83535 12.85958 12.88400 12.90864 12.93350
## [449] 12.95860 12.98393#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log10 SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")